home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Atari Mega Archive 1
/
Atari Mega Archive - Volume 1.iso
/
language
/
xlispsrc.arc
/
XLPP.C
< prev
next >
Wrap
C/C++ Source or Header
|
1988-02-11
|
2KB
|
113 lines
/* xlpp.c - xlisp pretty printer */
/* Copyright (c) 1985, by David Betz
All Rights Reserved */
#include "xlisp.h"
/* external variables */
extern LVAL s_stdout;
extern int xlfsize;
/* local variables */
static int pplevel,ppmargin,ppmaxlen;
static LVAL ppfile;
/* xpp - pretty-print an expression */
LVAL xpp()
{
LVAL expr;
/* get expression to print and file pointer */
expr = xlgetarg();
ppfile = (moreargs() ? xlgetfile() : getvalue(s_stdout));
xllastarg();
/* pretty print the expression */
pplevel = ppmargin = 0; ppmaxlen = 40;
pp(expr); ppterpri(ppfile);
/* return nil */
return (NIL);
}
/* pp - pretty print an expression */
LOCAL pp(expr)
LVAL expr;
{
if (consp(expr))
pplist(expr);
else
ppexpr(expr);
}
/* pplist - pretty print a list */
LOCAL pplist(expr)
LVAL expr;
{
int n;
/* if the expression will fit on one line, print it on one */
if ((n = flatsize(expr)) < ppmaxlen) {
xlprint(ppfile,expr,TRUE);
pplevel += n;
}
/* otherwise print it on several lines */
else {
n = ppmargin;
ppputc('(');
if (atom(car(expr))) {
ppexpr(car(expr));
ppputc(' ');
ppmargin = pplevel;
expr = cdr(expr);
}
else
ppmargin = pplevel;
for (; consp(expr); expr = cdr(expr)) {
pp(car(expr));
if (consp(cdr(expr)))
ppterpri();
}
if (expr != NIL) {
ppputc(' '); ppputc('.'); ppputc(' ');
ppexpr(expr);
}
ppputc(')');
ppmargin = n;
}
}
/* ppexpr - print an expression and update the indent level */
LOCAL ppexpr(expr)
LVAL expr;
{
xlprint(ppfile,expr,TRUE);
pplevel += flatsize(expr);
}
/* ppputc - output a character and update the indent level */
LOCAL ppputc(ch)
int ch;
{
xlputc(ppfile,ch);
pplevel++;
}
/* ppterpri - terminate the print line and indent */
LOCAL ppterpri()
{
xlterpri(ppfile);
for (pplevel = 0; pplevel < ppmargin; pplevel++)
xlputc(ppfile,' ');
}
/* flatsize - compute the flat size of an expression */
LOCAL int flatsize(expr)
LVAL expr;
{
xlfsize = 0;
xlprint(NIL,expr,TRUE);
return (xlfsize);
}